(* ===================================================================== *)
(** CALEND PIPE : module stand_alone, 
    fonctions de traitement de la sortie du bios avec un pipe,
    pour afficher un calendrier sommaire.
    @author Mathieu Barbin, Ocan SANKUR
    @version 0.0 samedi 27/10/07 *)
(* ===================================================================== *)

(* #load "graphics.cma";;*)

open Graphics

(* ===================================================================== *)
(** Classe virtuelle : Objet de type traitement sequentielle. 
init : pour initialiser (ouvir tous les fichiers)
quit : pour quitter (fermer tous les fichiers)
lecture : realise un cycle de lecture des entrees, et les assigne
par effet de bord a l'argument bool array.*)
(* ===================================================================== *)
class virtual traitement_seq tab_entrees tab_sorties = 
object
  method virtual get_nom_entrees : string array
  method virtual get_nom_sorties : string array
  method virtual init : unit
  method virtual quit : unit
  method virtual traite : bool array -> bool array -> unit
end
(* ===================================================================== *)

(* ===================================================================== *)
(** transtypage des bool vers les int : true donne 1 et false donne 0 *)
(* ===================================================================== *)
let int_of_bool = function
    true -> 1
  | false -> 0
(* ===================================================================== *)


(* ===================================================================== *)
(*           APPLICATION GRAPHIQUE : CALENDRIER DIGITAL                  *)
(* ===================================================================== *)

(* ===================================================================== *)
(** Creer les tableaux des coordonnees des prismes horizontaux *)
(* ===================================================================== *)
let h_tab d x y =
  let u = 4 * d in
  let usur2 = 2 * d in
  let u5 = 5 * u in
  let u6 = 6 * u in
  [|
    (x, y);
    (x + usur2, y + usur2);
    (x + usur2 + u5, y + usur2 );
    (x + u6, y);
    (x + usur2 + u5, y - usur2);
    (x + usur2, y - usur2);
    (x, y)
  |]
(* ===================================================================== *)



(* ===================================================================== *)
(** Creer les tableaux des coordonnees des prismes verticaux (italique : di) *)
(* ===================================================================== *)
let v_tab di d x y =
  let isur2 = 2 * di in
  let u = 4 * d in
  let usur2 = 2 * d in
  let u5 = 5 * u in
  let u6 = 6 * u in
  [|
    (x, y);
    (x - usur2, y + usur2);
    (x - usur2 + isur2, y + usur2 + u5);
    (x + isur2, y + u6);
    (x + usur2 + isur2, y + usur2 + u5);
    (x + usur2, y + usur2);
    (x, y)
  |]
(* ===================================================================== *)


(* ===================================================================== *)
(** Transtypage classique des booléens vers les char *)
(* ===================================================================== *)
let char_of_bool = function
  | true -> '1'
  | false -> '0'
(* ===================================================================== *)

(* ===================================================================== *)
(** Transtypage classique des char vers les booléens*)
(* ===================================================================== *)
let bool_of_char = function
  | '1' -> true
  | _ -> false
(* ===================================================================== *)

(* ===================================================================== *)
(** Le type qui permet de decrire un chiffre du cadran d'affichage *)
(* ===================================================================== *)
type description_chiffre = 
{
  cadre : int * int * int * int;
  coord_prisme : (int * int) array array;
  cache_text : int * int * int * int;
  points_attache : (int * int) array; 
  fils : (int * int) array array;
  text_coord : (int * int) array
}
(* ===================================================================== *)


(* ===================================================================== *)
(** Donner toutes les coordonnées du cadran : voir le papier milimétré 
    original qui est donc en cm  *)
(* ===================================================================== *)
let description_of_param d x y = 
  let p = ((float_of_int d) /. 5.) in
  let cm = 2 * d in
  let hh = h_tab d and vv = v_tab d d in
  let _prismes = 
    [|
      vv (x + 6 * cm)  (y + 22 * cm + d);
      hh (x + 6 * cm + d) (y + 22 * cm);
      vv (x + 5 * cm) (y + 9 * cm + d);
      hh (x + 5 * cm + d) (y + 9 * cm);
      vv (x + 18 * cm) (y + 9 * cm + d);
      vv (x + 19 * cm) (y + 22 * cm + d);
      hh (x + 7 * cm + d) (y + 35 * cm) 
    |]
  and _points =
    [|
      (x + 5 * cm, y + 23 * cm + d);
      (x + 6 * cm + d, y + 22 * cm);
      (x + 5 * cm, y + 9 * cm + d);
      (x + 11 * cm + d, y + 8 * cm);
      (x + 18 * cm, y + 9 * cm + d);
      (x + 20 * cm, y + 23 * cm + d);
      (x + 19 * cm + d, y + 35 * cm)
    |]
  and _fils = 
    [|
      [|
	(x + 5 * cm, y + 23 * cm + d);
	(x + (int_of_float (33. *. p)), y + 23 * cm + d);
	(x + (int_of_float (16. *. p)), y + 6 * cm + d);
	(x + 5 * cm + d, y + 6 * cm + d);
	(x + 5 * cm + d, y + 5 * cm )	
      |];
      
      [|
	(x + 6 * cm + d, y + 22 * cm);
	(x + (int_of_float (42. *. p)), y + 22 * cm);
	(x + (int_of_float (26. *. p)), y + 7 * cm);
	(x + 7 * cm + d, y + 7 * cm);
	(x + 7 * cm +d, y + 5 * cm)
      |];
      
      [|
	(x + 5 * cm, y + 9 * cm + d);
	(x + (int_of_float (47. *. p)), y + 7 * cm + d);
	(x + 9 * cm + d, y + 7 * cm + d);
	(x + 9 * cm + d, y + 5 * cm)
      |];

      [|
	(x + 11 * cm + d, y + 8 * cm);
	(x + 11 * cm + d, y + 5 * cm)
      |];
      
      [|
	(x + 18 * cm, y + 9 * cm + d);
	(x + (int_of_float (178. *. p)), y + 7 * cm + d);
	(x + 13 * cm + d, y + 7 * cm + d);
	(x + 13 * cm + d, y + 5 * cm)
      |];

      
      [| 
	(x + 20 * cm, y + 23 * cm + d);
	(x + (int_of_float (213. *. p)), y + 23 * cm + d);
	(x + (int_of_float (197. *. p)), y + 7 * cm);
	(x + 15 * cm + d, y + 7 * cm);	
	(x + 15 * cm + d, y + 5 * cm);	
      |];
      
      [|
	(x + 19 * cm + d, y + 35 * cm);
	(x + (int_of_float (234. *. p)), y + 35 * cm);
	(x + (int_of_float (207. *. p)), y + 6 * cm + d);
	(x + 17 * cm + d, y + 6 * cm + d);
	(x + 17 * cm + d, y + 5 * cm)
      |]
      
    |]
  and _text =
    let ip = int_of_float p in
    [|
      (x + 5 * cm + ip, y + 1 * cm + d);
      (x + 7 * cm + ip, y + 1 * cm + d);
      (x + 9 * cm + ip, y + 1 * cm + d);
      (x + 11 * cm + ip, y + 1 * cm + d);
      (x + 13 * cm + ip, y + 1 * cm + d);
      (x + 15 * cm + ip, y + 1 * cm + d);
      (x + 17 * cm + ip, y + 1 * cm + d)
    |]
  in
{
  cadre = x, y, 25 * cm, 38 * cm;
  coord_prisme = _prismes;
  (* cache texte : rectangle *)
  cache_text = x + 4 * cm, y + cm, 15 * cm, 3 * cm;
  points_attache = _points;
  (* coordonnees du texte *)
  fils = _fils;
  text_coord = _text
}
(* ===================================================================== *)



(* ===================================================================== *)
(** Le style du cadran : reglage des couleurs de la montre *)
(* ===================================================================== *)
type description_style = 
{
  couleur_fils : color;
  couleur_on : color;
  couleur_off : color;
  couleur_fond : color;
  couleur_cadre : color
}
(* ===================================================================== *)


(* ===================================================================== *)
(** Interface de la classe qui gere les chiffres du cadran graphique *)
(* ===================================================================== *)
class type type_chiffre =
object
  val s : description_style
  val prisme_state :  bool array
  val des : description_chiffre 
  method private refresh_prisme : int -> unit
  method private update_prisme : int -> bool -> unit
  method private plot_string_state : unit
  method init : unit
  method update : bool array -> int -> unit
end
(* ===================================================================== *)


(* ===================================================================== *)
(** Gerer les Objets chiffres du cadran *) 
(* ===================================================================== *)
class chiffre taille style x y : type_chiffre =
object(this)
 (* val text_size = 16 *)
  val ry = 3
  val s = style;
  val prisme_state = Array.make 7 false
  val des = description_of_param taille x y

  method private refresh_prisme i = 
    let etat = prisme_state.(i) in
    begin
      if etat then set_color s.couleur_on else set_color s.couleur_off;
      fill_poly des.coord_prisme.(i);
      set_color s.couleur_fils;
      match des.points_attache.(i) with
      | a,b -> fill_circle a b ry
    end

  method private update_prisme i new_val =
    begin
      prisme_state.(i) <- new_val;
      this#refresh_prisme i;
    end

  method private plot_string_state = 
    begin
    (*  set_text_size text_size; *)
      set_color s.couleur_fond;
      (
      match des.cache_text with
	(a,b,l,h) -> 
	  begin
	    fill_rect a b l h;
	  end
      );

      set_color s.couleur_on;
      for i = 0 to 6 do
	match des.text_coord.(i) with
	| a,b -> 
	    begin
	      moveto a b;
              draw_char (char_of_bool prisme_state.(i));
	    end
      done;
    end 


  method init =
    begin
      set_color s.couleur_fils;
      for i = 0 to 6 do
	draw_poly_line des.fils.(i);
	match des.points_attache.(i) with
	| a,b -> fill_circle a b ry
      done;
      for i = 0 to 6 do
	this#refresh_prisme i
      done;
      
      set_color s.couleur_cadre;
      (
      match des.cadre with
      | a,b,l,h -> draw_rect a b l h
      );
      this#plot_string_state
    end

  method update new_val index =
    let do_string = ref false in
    begin
      for i = 0 to 6 do
	if prisme_state.(i) <> new_val.(index+i)
	then
	  begin
	    do_string := true;
            this#update_prisme i new_val.(index+i);
	  end
	else ()
      done;
      if (!do_string) 
      then
	this#plot_string_state
      else ()
    end
end
(* ===================================================================== *)

let string_of_day = function
  | 1 -> "lundi"
  | 2 -> "mardi"
  | 3 -> "mercredi"
  | 4 -> "jeudi"
  | 5 -> "vendredi"
  | 6 -> "samedi"
  | 7 -> "dimanche"
  | _ -> failwith "string_of_day";;

(* on donne les coordonnees de la case bas gauche, et le dh par mot *)
class jour style x y dh =
object(this)
 (* val text_size = 16 *)
  val long = 30
  val ry = 3
  val s = style;
  val state = Array.make 7 false
  val coo = Array.init 7 (fun i -> x, y-i*dh)

  method private refresh_state i = 
    let etat = state.(i) in
    match coo.(i) with
      | a, b ->
          begin
            set_color s.couleur_fond;
            fill_rect a b long (dh-2);
            if etat then set_color s.couleur_on else set_color s.couleur_off;
            moveto (a+1) (b+1);
            draw_string (string_of_day (succ i))
          end

  method private update_state i new_val =
    begin
      state.(i) <- new_val;
      this#refresh_state i;
    end

  method init =
    for i = 0 to 6 do
      this#refresh_state i
    done;
    
  method update new_val index =
    for i = 0 to 6 do
      if state.(i) <> new_val.(index+i)
      then this#update_state i new_val.(index+i)
      else ()
    done
end
(* ===================================================================== *)






(* ===================================================================== *)
(** Proposition de style pour l'affichage : vert sur noir *)
(* ===================================================================== *)
let time_style =  
{
  couleur_fils = red;
  couleur_on = green;
  couleur_off = rgb 0 30 0;
  couleur_fond = black;
  couleur_cadre = yellow
}

let date_style =  
{
  couleur_fils = yellow;
  couleur_on = magenta;
  couleur_off = rgb 0 30 30;
  couleur_fond = black;
  couleur_cadre = blue
}
(* ===================================================================== *)



(* ===================================================================== *)
(** Classe du cadran : les valeurs entieres sont calculees pour que le 
    cadran soit bien centré et ne deborde pas de l'ecran *)
(* ===================================================================== *)
class calendrier style_time style_date =
  let espace_time = 150 and x_t = 14 and y_t = 240 in
  let espace_date = 100 and x_j = 60 and y_j = 160 and dh_j = 20 and x_d = 150 and y_d = 30 in
object(this)
  val chiffre_time = Array.init 6
    (fun i -> new chiffre 3 style_time (x_t + espace_time * i + (i/2) * (espace_time/4)) y_t)
  val chiffre_date = Array.init 6 
    (fun i -> new chiffre 2 style_date (x_d + espace_date * i + (i/2) * espace_date) y_d)
    
  val carres_time = [|(x_t+310,y_t+140); (x_t+645,y_t+140);
		      (x_t+310,y_t+110); (x_t+645,y_t+110) |]

  val carres_date = [|(x_d+240,y_d); (x_d+540,y_d) |]

  val jour = new jour style_date x_j y_j dh_j

  method private plot_carres =
    let affiche_carre ver hor (a,b) = 
      fill_poly [|(a,b);(a+3,b+ver);(a+3+hor,b+ver);(a+hor,b);(a,b)|]
    in 
    begin
      set_color style_time.couleur_on;
      Array.iter (affiche_carre 12 12) carres_time;
      set_color style_date.couleur_on;
      Array.iter (affiche_carre 150 6) carres_date
    end

  method init = 
    begin
      for i = 0 to 5 do
	chiffre_date.(i)#init;
	chiffre_time.(i)#init
      done;
      this#plot_carres
    end

  method update tab = 
    (* le tableau est donné a l'envers (91 booleens) *)
    begin
      for i = 0 to 5 do
        (* les chiffres de la montre sont codés de gauche à droite *)
	chiffre_time.(i)#update tab (7*(5-i));
      done;
      (* le jour de la semaine *)
      (* jour#update tab 42; *)
      (* les chiffres de la date : donnés de gauche à droite, unité, dizaine *)
      for i = 0 to 2 do
	chiffre_date.(2*i+1)#update tab (49+7*2*i);
        chiffre_date.(2*i)#update tab (56+7*2*i);
      done; 
    end
end
(* ===================================================================== *)


(* ===================================================================== *)
(** Expancier les arguments vectoriels d'une net list.*)
(* ===================================================================== *)
let string_list pref n = 
  let rec aux accu i =
    if i < 0 
    then accu
    else aux ((Printf.sprintf "%s[%d]" pref i)::accu) (pred i)
  in aux [] (pred n)
(* ===================================================================== *)

(* ===================================================================== *)
(** Expancier tout une liste d'arguments vectoriels d'une net list *)
(* ===================================================================== *)
let rec expand_arg_list = function
    | [] -> []
    | (n, i)::q -> (string_list n i)@(expand_arg_list q)
(* ===================================================================== *)


(* ===================================================================== *)
(** Vous en avez revé ? On l'a fait : le calendrier digital graphique *)
(* ===================================================================== *)
class calendrier_digital = 
  let sorties = Array.of_list 
    (expand_arg_list [("s1",7);("s10",7);("m1",7);("m10",7);("h1",7);("h10",7);
		      ("j1",7);("j10",7);("mois1",7);("mois10",7);("a1",7);("a10",7)])
  in
object 
  inherit traitement_seq [||] sorties 
  val mutable index_cycle = 0
  val nb_entrees = 0
  val nb_sorties = 84
  val nom_entrees = [||]
  val nom_sorties = sorties
  val le_calendrier = new calendrier date_style date_style 
  (* methodes *)

  method get_nom_entrees = nom_entrees

  method get_nom_sorties = nom_sorties
    
  method init = 
    begin
      index_cycle <- 0;
      open_graph " 1000x500";
      set_color black;
      fill_rect 0 0 1000 500;
      set_window_title "Bebop 1.0 - Projet Visa : Calendrier Digital (Mathieu Barbin, Ocan Sankur)";
      le_calendrier#init
    end

  method traite etat_entree etat_sortie =
    begin
      
      le_calendrier#update etat_sortie;

      if index_cycle = max_int
      then index_cycle <- 0
      else index_cycle <- succ index_cycle;
    end
  
  method quit = 
    begin
      ignore (wait_next_event [Button_down;Key_pressed]);
      close_graph ()
    end
end
(* ===================================================================== *)


let _ = 
  let with_output = not(List.mem "-no" (Array.to_list Sys.argv)) in 
  let length = 91 in
  let tab = Array.make length false in
  let m = new calendrier_digital in
  begin
    m#init;
    while true do
      let line = input_line stdin in
      if String.length line <> length 
      then 
	begin
	  Printf.printf "Length : %d, expected %d.\n" (String.length line) length;
	  flush stdout
	end
      else 
	begin
	  for i = 0 to pred length do
	    Array.unsafe_set tab i (bool_of_char (String.unsafe_get line i))
	  done;
	  m#traite [||] tab;
	  if with_output
          then print_newline ()
          else ()
	end
    done;
  end
  
